home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / Source / AmigaUtil / DosUtil.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  3.3 KB  |  143 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: DosUtil.mod $
  4.   Description: Support for clients of dos.library
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 3.8 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:30:04 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. <* STANDARD- *> <* INITIALISE- *> <* MAIN- *>
  18. <*$ CaseChk-  IndexChk- LongVars+ NilChk-  *>
  19. <*$ RangeChk- StackChk- TypeChk-  OvflChk- *>
  20.  
  21. MODULE DosUtil;
  22.  
  23. IMPORT e := Exec, d := Dos, s := Sets;
  24.  
  25. CONST (* Returned by ObjectExists() *)
  26.  
  27.   no    *= 0;
  28.   file  *= 1;
  29.   dir   *= 2;
  30.   other *= 3;
  31.  
  32. VAR
  33.  
  34.   enableBreak *: BOOLEAN;
  35.  
  36. (*------------------------------------*)
  37. PROCEDURE ObjectExists * ( path : ARRAY OF CHAR ) : INTEGER;
  38.  
  39.   VAR
  40.     lock : d.FileLockPtr;
  41.     fib : d.FileInfoBlockPtr;
  42.     result : INTEGER;
  43.  
  44. <*$CopyArrays-*>
  45. BEGIN (* ObjectExists *)
  46.   result := no;
  47.   lock := d.Lock (path, d.sharedLock);
  48.   IF lock # NIL THEN
  49.     fib := d.AllocDosObjectTags (d.fib, NIL);
  50.     IF fib # NIL THEN
  51.       IF d.Examine (lock, fib^) THEN
  52.         IF fib.dirEntryType < 0 THEN result := file
  53.         ELSIF fib.dirEntryType > 0 THEN result := dir
  54.         ELSE result := other
  55.         END
  56.       END;
  57.       d.FreeDosObject (d.fib, fib)
  58.     END;
  59.     d.UnLock (lock)
  60.   END;
  61.   RETURN result
  62. END ObjectExists;
  63.  
  64. (*------------------------------------*)
  65. PROCEDURE FileExists * (path : ARRAY OF CHAR) : BOOLEAN;
  66.  
  67. <*$CopyArrays-*>
  68. BEGIN (* FileExists *)
  69.   RETURN (ObjectExists (path) = file)
  70. END FileExists;
  71.  
  72. (*------------------------------------*)
  73. PROCEDURE DirExists * (path : ARRAY OF CHAR) : BOOLEAN;
  74.  
  75. <*$CopyArrays-*>
  76. BEGIN (* DirExists *)
  77.   RETURN (ObjectExists (path) = dir)
  78. END DirExists;
  79.  
  80. (*------------------------------------*)
  81. (*
  82.   Searches for "file" in the current directory first, followed by the
  83.   directories listed in "paths".  If it is found the procedure returns TRUE
  84.   and the full pathname of the file is returned in "fullPath".  If not, the
  85.   procedure returns FALSE and fullPath is set to "".
  86. *)
  87.  
  88. PROCEDURE Search *
  89.   ( VAR paths    : ARRAY OF e.LSTRPTR;
  90.         file     : ARRAY OF CHAR;
  91.     VAR fullPath : ARRAY OF CHAR)
  92.   : BOOLEAN;
  93.  
  94.   VAR index : INTEGER; len : LONGINT; ch : CHAR;
  95.  
  96. <*$CopyArrays-*>
  97. BEGIN (* Search *)
  98.   fullPath [0] := 0X; index := 0;
  99.   LOOP
  100.     IF ~d.AddPart (fullPath, file, LEN (fullPath)) THEN
  101.       RETURN FALSE
  102.     END;
  103.     IF FileExists (fullPath) THEN RETURN TRUE END;
  104.     IF paths [index] = NIL THEN
  105.       fullPath [0] := 0X; RETURN FALSE
  106.     ELSE
  107.       COPY (paths [index]^, fullPath); INC (index)
  108.     END
  109.   END
  110. END Search;
  111.  
  112.  
  113. PROCEDURE CheckBreak* ( breaks : s.SET32 ) : BOOLEAN;
  114.  
  115.   VAR signals : s.SET32;
  116.  
  117. BEGIN (* CheckBreak *)
  118.   IF enableBreak THEN
  119.     signals := e.SetSignal ({}, {});
  120.     RETURN (signals * breaks) # {}
  121.   ELSE RETURN FALSE
  122.   END
  123. END CheckBreak;
  124.  
  125.  
  126. PROCEDURE HaltIfBreak * ( breaks : s.SET32 );
  127.  
  128.   VAR signals : s.SET32;
  129.  
  130. BEGIN (* HaltIfBreak *)
  131.   IF enableBreak THEN
  132.     signals := e.SetSignal ({}, {});
  133.     IF (signals * breaks) # {} THEN
  134.       enableBreak := FALSE;
  135.       IF d.PutStr ("\n***BREAK -- User aborted\n") = 0 THEN END;
  136.       HALT (d.warn)
  137.     END
  138.   END
  139. END HaltIfBreak;
  140.  
  141. BEGIN enableBreak := TRUE
  142. END DosUtil.
  143.